home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / FGL304F.ZIP;1 / EXFOR.ARJ / FGDOC / EXAMPLES / FORTRAN / 06-01.FOR < prev    next >
Encoding:
Text File  |  1994-01-24  |  1.8 KB  |  75 lines
  1. $INCLUDE: 'C:\FG\INTRFACE.FOR'
  2.  
  3.       PROGRAM MAIN
  4.  
  5.       INTEGER*2 AREA
  6.       INTEGER*2 COLOR, OLD_COLOR
  7.       INTEGER*2 LEFT
  8.       INTEGER*2 MAX_COLOR, MAX_X, MAX_Y
  9.       INTEGER*2 NEW_MODE, OLD_MODE
  10.       INTEGER*2 X, Y
  11.       INTEGER*2 FG_AUTOMODE, FG_GETMAXX, FG_GETMAXY
  12.       INTEGER*2 FG_GETMODE, FG_GETPIXEL
  13.       INTEGER*2 RANDOM
  14.  
  15.       OLD_MODE = FG_GETMODE()
  16.       NEW_MODE = FG_AUTOMODE()
  17.       CALL FG_SETMODE(NEW_MODE)
  18.  
  19.       IF (NEW_MODE .EQ. 4) THEN
  20.          MAX_COLOR = 3
  21.       ELSE IF (NEW_MODE .EQ. 11 .OR. NEW_MODE .EQ. 17) THEN
  22.          MAX_COLOR = 1
  23.       ELSE IF (NEW_MODE .EQ. 19) THEN
  24.          MAX_COLOR = 255
  25.       ELSE
  26.          MAX_COLOR = 15
  27.       END IF
  28.  
  29.       LEFT = 100
  30.       MAX_X = FG_GETMAXX() - 1
  31.       MAX_Y = FG_GETMAXY() - 1
  32.  
  33. 10    IF (LEFT .GT. 0) THEN
  34.  
  35.          X = RANDOM(1,MAX_X)
  36.          Y = RANDOM(1,MAX_Y)
  37.  
  38.          AREA = FG_GETPIXEL(X-1,Y-1) + FG_GETPIXEL(X,Y-1) +
  39.      +          FG_GETPIXEL(X+1,Y-1) + FG_GETPIXEL(X-1,Y) +
  40.      +          FG_GETPIXEL(X,Y)     + FG_GETPIXEL(X+1,Y) +
  41.      +          FG_GETPIXEL(X-1,Y+1) + FG_GETPIXEL(X,Y+1) +
  42.      +          FG_GETPIXEL(X+1,Y+1)
  43.  
  44.          IF (AREA .EQ. 0) THEN
  45.             COLOR = RANDOM(1,MAX_COLOR)
  46.             CALL FG_SETCOLOR(COLOR)
  47.             CALL FG_POINT(X,Y)
  48.             LEFT = LEFT - 1
  49.          END IF
  50.  
  51.          GO TO 10
  52.       END IF
  53.  
  54.       CALL FG_WAITKEY
  55.  
  56.       CALL FG_SETMODE(OLD_MODE)
  57.       CALL FG_RESET
  58.  
  59.       STOP ' '
  60.       END
  61.  
  62.       INTEGER*2 FUNCTION RANDOM(MIN,MAX)
  63.  
  64.       INTEGER*2 MIN, MAX
  65.       INTEGER*2 SEED, TEMP
  66.  
  67.       DATA SEED /12345/
  68.  
  69.       TEMP = IEOR(SEED,ISHFT(SEED,-7))
  70.       SEED = IAND(IEOR(ISHFT(TEMP,8),TEMP),#7FFF)
  71.       RANDOM = MOD(SEED,MAX-MIN+1) + MIN
  72.  
  73.       RETURN
  74.       END
  75.